home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d11 / basmus.arc / MUSICBOX.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1990-09-29  |  14.5 KB  |  288 lines
  1. 100  REM         ----- BLUES -----
  2. 101  '           TYPED IN WITH MODIFICATIONS BY D.G. PATTERSON
  3. 102  '           SEE SOFTSIDE MAGAZINE FOR INSTRUCTIONS
  4. 106  '           PROGRAM TO WRITE MUSIC.---TAKEN FROM SOFTSIDE #34  NOV 1982
  5. 107  '           SOME FUNCTIONS NOT ACTIVATED - THEY WILL BE ADDED IN FUTURE
  6. 108  '           ISSUES OF SOFTSIDE AND POSTED TO PCanada....
  7. 116  CLS:KEY OFF:DEFINT A-Z:MAX=2000:DIM NCURS(38),SHARP(38),FLAT(38),STAFF(1884),NOTE1(38),NOTE2(38),NOTE4(38),NOTE8(38),NOTE16(38),NOTE32(38),NOTE64(38),BLOCK(99,2),M$(2000),PCL(154),PCC(154),PCR(154)
  8. 118  DIM FU$(10)
  9. 120  DIM REST1(38),REST2(38),REST4(38),REST8(38),REST16(38),REST32(38),REST64(38),PIANOL(104),PIANOR(104),PIANOC(104),DOT(38),NDY(35),BK(5):DEF FNU$(A$)=CHR$(ASC(LEFT$(A$,1))+32*(LEFT$(A$,1)>"Z"))
  10. 124  DEF FNL2!(X)=LOG(X)/LOG(2):DEF FNS$(N$)=RIGHT$(N$,LEN(N$)-1):TRUE=-1:FALSE=0:FLAT=FALSE:SHARP=FALSE:OC=3:CN$="C":SCALE$="CDEFGAB":NN=7*OC-6
  11. 128  STAFFX=5:STAFFY=55:PTN$="":X$="C C#D E-E F F#G A-A B-B ":FOR X=1 TO 5:PTN$=PTN$+X$:NEXT:PSCALE$="C.D.EF.G.A.B":PTNPTR=(12*(OC-1)+INSTR(PSCALE$,CN$)-SHARP+FLAT)*2-1
  12. 132  KBX=123:KBY=6:NX=6:NY=160:RX=6:RY=180:MIDC=30:NDX=STAFFX+49:RDX=NDX-2:RDY=STAFFY
  13. 135  NCOUNT=0:TEMPO=100:BCOUNT=0:DOTTED=FALSE:NOTE=TRUE:PREVNOTE=NOTE:TIME=4:PREVTIME=TIME:PREVDOT=DOTTED:PREVPTR=PTNPTR:BCOUNT=0:BPOS=0:NCOUNT=1:NPOS=1:INSERTING=FALSE:GOSUB 13000:CLS:X$="Just a moment...":LOCATE 12,20-LEN(X$)/2:PRINT X$
  14. 140  GOSUB 16170:GOSUB 2000:GOSUB 15000:GOSUB 14000
  15. 141  '
  16. 142  '           ***** MAIN INPUT LOOP:ACCEPT VALID CHARACTERS;REJECT  *****
  17. 143  '           ***** INVALID ONES;BRANCH TO APPROPRIATE SUBROUTINES. *****
  18. 144  '
  19. 1000  IN$=INKEY$:IF IN$="" THEN 1000
  20. 1010  IF FNU$(IN$)="S" THEN GOSUB 18000:GOTO 1150
  21. 1020  IF FNU$(IN$)="L" THEN GOSUB 17000:GOTO 1150
  22. 1030  IF FNU$(IN$)="P" THEN GOSUB 19000:GOTO 1150
  23. 1040  IF FNU$(IN$)="T" THEN GOSUB 20000:GOTO 1150
  24. 1045  IF FNU$(IN$)=" " THEN GOSUB 11000:NOTE=NOT NOTE:GOTO 1150
  25. 1050  IF FNU$(IN$)="N" THEN GOSUB 21000:GOTO 1150
  26. 1055  IF FNU$(IN$)="C" THEN GOSUB 22000:GOTO 1150
  27. 1060  IF FNU$(IN$)=CHR$(13) THEN GOSUB 16000:GOTO 1150
  28. 1065  IF FNU$(IN$)=CHR$(3) THEN GOSUB 23000:GOTO 1150
  29. 1067  IF FNU$(IN$)="M" THEN RUN "MENU"
  30. 1070  IF ASC(LEFT$(IN$,1))<>0 THEN 1000 ELSE IN=ASC(RIGHT$(IN$,1))
  31. 1080  IF IN<59 OR (IN>68 AND IN<72) OR IN=73 OR IN=79 OR IN>80 THEN 1000
  32. 1090  IF IN=72 THEN GOSUB 3000:GOTO 1150
  33. 1100  IF IN=75 THEN GOSUB 6000:GOTO 1150
  34. 1110  IF IN=77 THEN GOSUB 5000:GOTO 1150
  35. 1120  IF IN=80 THEN GOSUB 4000:GOTO 1150
  36. 1140  ON IN-58 GOSUB 8000,7000,50000,50000,50000,50000,50000,50000,9000,10000
  37. 1150  GOSUB 2000
  38. 1160  GOSUB 12000:GOTO 1000
  39. 1989  END
  40. 1990  '
  41. 1992  '          ***** CALCULATIONS OF NEW VALUES FOR OC     *****
  42. 1993  '          ***** SHARP,FLAT,NN,N$, AND AC$. THE        *****
  43. 1994  '          ***** VALUE OF PTNPTR IS THE SOLE PARAMETER *****
  44. 1995  '          ***** OF THIS ROUTINE.                      *****
  45. 1998  '
  46. 2000  N$=MID$(PTN$,PTNPTR,2):CN$=LEFT$(N$,1):AC$=RIGHT$(N$,1):IF AC$=" " THEN SHARP=FALSE:FLAT=FALSE
  47. 2030  IF AC$="#" THEN SHARP=TRUE:FLAT=FALSE
  48. 2040  IF AC$="-" THEN SHARP=FALSE:FLAT=TRUE
  49. 2060  OC=((PTNPTR-1)/2-INSTR(PSCALE$,CN$))/12+1:NN=7*OC+INSTR(SCALE$,CN$)-7:RETURN
  50. 2990  '
  51. 2992  '          ***** INCREMENT PITCH OF NOTE ONE HALF-STEP *****
  52. 2998  '
  53. 3000  GOSUB 11000:PTNPTR=PTNPTR+2:IF PTNPTR>119 THEN PTNPTR=1
  54. 3010  RETURN
  55. 3990  '
  56. 3992  '          ***** DECREMENT PITCH ONE HALF-STEP. *****
  57. 3998  '
  58. 4000  GOSUB 11000:PTNPTR=PTNPTR-2:IF PTNPTR<1 THEN PTNPTR=119
  59. 4010  RETURN
  60. 4990  '
  61. 4992  '          ***** MOVE TIME INDICATOR TO THE RIGHT. THIS   *****
  62. 4994  '          ***** SHORTENS THE LENGTH OF THE NOTE OR REST. *****
  63. 5000  GOSUB 11000:IF NOTE THEN 5050
  64. 5020  IF TIME=64 THEN TIME=1 ELSE TIME=TIME*2
  65. 5030  RETURN
  66. 5050  IF DOTTED THEN DOTTED=FALSE:RETURN
  67. 5060  DOTTED=TRUE:IF TIME=64 THEN TIME=1 ELSE TIME=TIME*2
  68. 5070  RETURN
  69. 5990  '
  70. 5992  '          ***** MOVE TIME INDICATOR TO THE LEFT. *****
  71. 5998  '
  72. 6000  GOSUB 11000:IF NOTE THEN 6040
  73. 6010  IF TIME=1 THEN TIME=64 ELSE TIME=TIME/2
  74. 6020  RETURN
  75. 6040  IF NOT DOTTED THEN DOTTED=TRUE:RETURN
  76. 6050  DOTTED=FALSE:IF TIME=1 THEN TIME=64 ELSE TIME=TIME/2
  77. 6060  RETURN
  78. 6990  '
  79. 6992  '          ***** MOVE UP AN OCTAVE *****
  80. 6998  '
  81. 7000  GOSUB 11000:PTNPTR=PTNPTR+24:IF PTNPTR>119 THEN PTNPTR=PTNPTR-120
  82. 7010  RETURN
  83. 7990  '
  84. 7992  '          ***** MOVE DOWN AN OCTAVE. *****
  85. 7998  '
  86. 8000  GOSUB 11000:PTNPTR=PTNPTR-24:IF PTNPTR<1 THEN PTNPTR=PTNPTR+120
  87. 8010  RETURN:GOSUB 11000 :IF NPOS=1 THEN RETURN
  88. 8990  '
  89. 8992  '          ***** MOVE TO THE PREVIOUS NOTE IN THE BUFFER *****
  90. 8998  '
  91. 9000  GOSUB 11000:IF NPOS=1 THEN RETURN
  92. 9010  NPOS=NPOS-1:IF BPOS>1 THEN IF NPOS=BLOCK(BPOS-1,2) THEN BPOS=BPOS-1
  93. 9020  C7$=MID$(M$(NPOS),10,2):N7$=LEFT$(C7$,1):TEMPO=VAL(MID$(M$(NPOS),2,3)):OC7=VAL(MID$(M$(NPOS),6,1)):DOTTED=(RIGHT$(M$(NPOS),1)="."):TIME=VAL(MID$(M$(NPOS),8,2)):NOTE=NOT (ASC(N7$)=80)
  94. 9060  SH7=(RIGHT$(C7$,1)="#"):FL7=(RIGHT$(C7$,1)="-"):IF NOTE THEN PTNPTR=(12*(OC7-1)+INSTR(PSCALE$,N7$)-SH7+FL7)*2-1:RETURN ELSE PTNPTR=49:RETURN
  95. 9990  '
  96. 9992  '          ***** MOVE TO THE NEXT NOTE IN THE BUFFER. *****
  97. 9998  '
  98. 10000  GOSUB 11000:IF NPOS>=NCOUNT-1 THEN NPOS=NCOUNT:PTNPTR=49:TIME=4:DOTTED=FALSE:NOTE=TRUE:RETURN
  99. 10010  NPOS=NPOS+1:IF NPOS=BLOCK(BPOS+1,1) THEN BPOS=BPOS+1
  100. 10020  C7$=MID$(M$(NPOS),10,2):N7$=LEFT$(C7$,1):TEMPO=VAL(MID$(M$(NPOS),2,3)):OC7=VAL(MID$(M$(NPOS),6,1)):DOTTED=(RIGHT$(M$(NPOS),1)="."):TIME=VAL(MID$(M$(NPOS),8,2)):NOTE=NOT (ASC(N7$)=80)
  101. 10060  SH7=(RIGHT$(C7$,1)="#"):FL7=(RIGHT$(C7$,1)="-"):IF NOTE THEN PTNPTR=(12*(OC7-1)+INSTR(PSCALE$,N7$)-SH7+FL7)*2-1:RETURN ELSE PTNPTR=49:RETURN
  102. 10090  '
  103. 10092  '         ***** SAVE THE PREVIOUS STATE OF THE SCREEN FOR *****
  104. 10094  '         ***** PROPER ERASURE OF SYMBOLS. *****
  105. 11000  PREVTIME=TIME:PREVDOT=DOTTED:PREVNOTE=NOTE:PREVPTR=PTNPTR:RETURN
  106. 11990  '
  107. 11992  '         ***** DISPLAY ROUTINE.RE-CREATE THE DATA OF   *****
  108. 11993  '         ***** THE PREVIOUS NOTE,USING THE INFORMATION *****
  109. 11994  '         ***** PRESERVED IN LINE 11000.                *****
  110. 11995  '
  111. 12000  PREVN$=MID$(PTN$,PREVPTR,2):PREVAC$=RIGHT$(PREVN$,1):PREVOC=((PREVPTR-1)/2-INSTR(PSCALE$,LEFT$(PREVN$,1)))/12+1:PREVNN=7*PREVOC+INSTR(SCALE$,LEFT$(PREVN$,1))-7:N2$=N$:IF AC$="-" THEN MID$(N2$,2,1)="b"
  112. 12040  '
  113. 12042  '         ***** UPDATE THE INFORMATION SQUARE. *****
  114. 12048  '
  115. 12050  LOCATE 3,31:IF DOTTED THEN PRINT USING "Tone  \ \";N2$+"." ELSE PRINT USING "Tone   \\";N2$
  116. 12060  LOCATE 2,31:PRINT USING "Octave  #";OC:LOCATE 6,31:PRINT USING "Note ####";NPOS:LOCATE 5,31:PRINT USING "Tempo ###";TEMPO:LOCATE 7,31:PRINT USING "Blocks ##";BCOUNT:LOCATE 4,31:PRINT USING "Length ##";TIME
  117. 12090  '
  118. 12092  '         ***** UPDATE THE TIME INDICATOR. *****
  119. 12098  '
  120. 12100  OLDTX=FNL2!(PREVTIME)*15+RX:IF PREVNOTE AND PREVDOT THEN PUT (OLDTX,NY),DOT
  121. 12110  PUT (OLDTX,RY+20*PREVNOTE),NCURS:TX=RX+15*FNL2!(TIME):PUT (TX,RY+20*NOTE),NCURS:IF NOTE AND DOTTED THEN PUT (TX,RY+20*NOTE),DOT
  122. 12150  '
  123. 12152  '         ***** UPDATE THE PIANO KEYS *****
  124. 12158  '
  125. 12160  X=INSTR(SCALE$,LEFT$(PREVN$,1)):XQ=INT(X-X/3+0.5):IF PREVAC$<>" " THEN PAINT (KBX+BK(XQ),KBY+5),0,2 ELSE IF X=2 OR X=5 OR X=6 THEN PUT (KBX+15*(X-1),KBY),PCC ELSE IF X=1 OR X=4 THEN PUT (KBX+15*(X-1),KBY),PCL ELSE PUT (KBX+15*(X-1),KBY),PCR
  126. 12180  X=INSTR(SCALE$,LEFT$(N$,1)):XQ=INT(X-X/3+0.5):IF AC$<>" " THEN PAINT (KBX+BK(XQ),KBY+5),1,2 ELSE IF X=2 OR X=5 OR X=6 THEN PUT (KBX+15*(X-1),KBY),PCC ELSE IF X=1 OR X=4 THEN PUT (KBX+15*(X-1),KBY),PCL ELSE PUT (KBX+15*(X-1),KBY),PCR
  127. 12190  LINE (0,0)-(319,199),3,B
  128. 12200  '
  129. 12202  '         ***** UPDATE THE STAFF *****
  130. 12208  '
  131. 12210  IF NOT PREVNOTE THEN 12440
  132. 12220  ON FNL2!(PREVTIME)+1 GOTO 12230,12240,12250,12260,12270,12280,12290
  133. 12230  PUT (NDX,NDY(PREVNN)),NOTE1:GOTO 12300
  134. 12240  PUT (NDX,NDY(PREVNN)),NOTE2:GOTO 12300
  135. 12250  PUT (NDX,NDY(PREVNN)),NOTE4:GOTO 12300
  136. 12260  PUT (NDX,NDY(PREVNN)),NOTE8:GOTO 12300
  137. 12270  PUT (NDX,NDY(PREVNN)),NOTE16:GOTO 12300
  138. 12280  PUT (NDX,NDY(PREVNN)),NOTE32:GOTO 12300
  139. 12290  PUT (NDX,NDY(PREVNN)),NOTE64
  140. 12300  IF PREVDOT THEN PUT (NDX,NDY(PREVNN)),DOT
  141. 12310  IF PREVAC$="-" THEN PUT (NDX-2,NDY(PREVNN)),FLAT ELSE IF PREVAC$="#" THEN PUT (NDX-2,NDY(PREVNN)),SHARP
  142. 12320  IF NOT NOTE THEN 12520 ELSE ON FNL2!(TIME)+1 GOTO 12330,12340,12350,12360,12370,12380,12390
  143. 12330  PUT (NDX,NDY(NN)),NOTE1:GOTO 12400
  144. 12340  PUT (NDX,NDY(NN)),NOTE2:GOTO 12400
  145. 12350  PUT (NDX,NDY(NN)),NOTE4:GOTO 12400
  146. 12360  PUT (NDX,NDY(NN)),NOTE8:GOTO 12400
  147. 12370  PUT (NDX,NDY(NN)),NOTE16:GOTO 12400
  148. 12380  PUT (NDX,NDY(NN)),NOTE32:GOTO 12400
  149. 12390  PUT (NDX,NDY(NN)),NOTE64
  150. 12400  IF DOTTED THEN PUT (NDX,NDY(NN)),DOT
  151. 12410  IF AC$="-" THEN PUT (NDX-2,NDY(NN)),FLAT ELSE IF AC$="#" THEN PUT (NDX-2,NDY(NN)),SHARP
  152. 12420  RETURN
  153. 12440  IF PREVNOTE THEN 12320 ELSE ON FNL2!(PREVTIME)+1 GOTO 12450,12460,12470,12480,12490,12500,12510
  154. 12450  PUT (RDX,RDY),REST1:GOTO 12320
  155. 12460  PUT (RDX,RDY),REST2:GOTO 12320
  156. 12470  PUT (RDX,RDY),REST4:GOTO 12320
  157. 12480  PUT (RDX,RDY),REST8:GOTO 12320
  158. 12490  PUT (RDX,RDY),REST16:GOTO 12320
  159. 12500  PUT (RDX,RDY),REST32:GOTO 12320
  160. 12510  PUT (RDX,RDY),REST64:GOTO 12320
  161. 12520  ON FNL2!(TIME)+1 GOTO 12530,12540,12550,12560,12570,12580,12590
  162. 12530  PUT (RDX,RDY),REST1:RETURN
  163. 12540  PUT (RDX,RDY),REST2:RETURN
  164. 12550  PUT (RDX,RDY),REST4:RETURN
  165. 12560  PUT (RDX,RDY),REST8:RETURN
  166. 12570  PUT (RDX,RDY),REST16:RETURN
  167. 12580  PUT (RDX,RDY),REST32:RETURN
  168. 12590  PUT (RDX,RDY),REST64:RETURN
  169. 12997  '
  170. 12998  '         ***** SET UP THE SHAPE TABLES *****
  171. 12999  '
  172. 13000  SCREEN 1:CLS:COLOR 0,1:STAFF$="S10 A000 BM000,000 C1 D8 R1 U8 L1 R1 BR40 D8 R1 U8 L1 L40 D2 R40 D2 L40 D2 R40 D2 L40":STAFF$=STAFF$+" L1 D16 R1 U8 L1 R1 BR40 D8 R1 U8 L1 L40 D2 R40 D2 L40 D2 R40 D2 L40":DRAW STAFF$:STAFF$=""
  173. 13030  GET (0,0)-(104,70),STAFF:CLS
  174. 13050  CIRCLE (4,13),3,2,,,0.55:GET (0,0)-(13,17),NOTE1:LINE (7,13)-(7,1),2:GET (0,0)-(13,17),NOTE2:PAINT (4,13),2,2:GET (0,0)-(13,17),NOTE4:LINE (7,1)-(12,3),2:GET (0,0)-(13,17),NOTE8:LINE (7,3)-(12,5),2:GET (0,0)-(13,17),NOTE16
  175. 13060  LINE (7,5)-(12,7),2:GET (0,0)-(13,17),NOTE32:LINE (7,7)-(12,9),2:GET (0,0)-(13,17),NOTE64:CLS
  176. 13080  LINE(2,0)-(2,6),2:LINE (4,0)-(4,6),2:LINE (1,2)-(5,2),2:LINE (1,4)-(5,4),2:GET (0,0)-(13,17),SHARP:CLS:LINE (2,0)-(2,6),2:LINE (2,6)-(6,4),2:LINE (6,4)-(2,2),2:GET (0,0)-(13,17),FLAT
  177. 13100  CLS:LINE (3,11)-(9,13),2,BF:GET (0,0)-(13,17),REST1:CLS:LINE (3,9)-(9,7),2,BF:GET (0,0)-(13,17),REST2:CLS:LINE (6,3)-(8,5),2:LINE (8,5)-(6,8),2:LINE (6,8)-(8,10),2:LINE (8,10)-(5,13),2:LINE (5,13)-(6,15),2:GET (0,0)-(13,17),REST4
  178. 13110  CLS:LINE (6,14)-(9,3),2:LINE (9,4)-(3,6),2:GET (0,0)-(13,17),REST8:LINE (9,6)-(3,8),2:GET (0,0)-(13,17),REST16:LINE (7,8)-(3,10),2:GET (0,0)-(8,16),REST32:LINE (7,10)-(3,12),2:GET (0,0)-(13,17),REST64
  179. 13130  CLS:LINE (0,0)-(9,30),3,BF:LINE (0,30)-(12,50),3,BF:GET (0,0)-(12,50),PIANOL
  180. 13131  PAINT (5,5),2,0:GET (0,0)-(12,50),PCL
  181. 13132  CLS:LINE (4,0)-(9,30),3,BF:LINE(0,30)-(12,50),3,BF:GET (0,0)-(12,50),PIANOC
  182. 13133  PAINT (5,5),2,0:GET (0,0)-(12,50),PCC
  183. 13134  CLS:LINE (4,0)-(12,30),3,BF:LINE (0,30)-(12,50),3,BF:GET (0,0)-(12,50),PIANOR
  184. 13135  PAINT (5,5),2,0:GET (0,0)-(12,50),PCR
  185. 13140  CLS:LINE (0,0)-(13,17),2,BF:GET (0,0)-(13,17),NCURS:CLS:PSET (10,14),2:PSET (10,15),2:PSET (11,14),2:PSET (11,15),2:GET (0,0)-(13,17),DOT:RETURN
  186. 13990  '
  187. 13992  '         ***** DRAW THE INITIAL SCREEN *****
  188. 14000  CLS:LINE (0,0)-(319,199),3,B:LINE (115,0)-(115,199),3:LINE (115,63)-(319,199),3,B:LINE (234,0)-(234,63),3
  189. 14030  PUT (KBX,KBY),PIANOL:PUT (KBX+15,KBY),PIANOC:PUT (KBX+30,KBY),PIANOR:PUT (KBX+45,KBY),PIANOL:PUT (KBX+60,KBY),PIANOC:PUT (KBX+75,KBY),PIANOC:PUT (KBX+90,KBY),PIANOR:LINE (KBX-3,KBY-2)-(KBX+105,KBY+52),3,B:PAINT (KBX+11,KBY+1),2,3
  190. 14050  FOR X=KBX+10 TO KBX+25 STEP 15:LINE (X+1,KBY)-(X+7,KBY+28),0,BF:NEXT X:FOR X=KBX+55 TO KBX+55+30 STEP 15:LINE (X+1,KBY)-(X+7,KBY+28),0,BF:NEXT X
  191. 14060  PUT (KBX,KBY),PCL
  192. 14070  LINE (0,NY-2)-(115,NY-2),3:PUT (NX,NY),NOTE1:PUT (NX+15,NY),NOTE2:PUT (NX+30,NY),NOTE4:PUT (NX+45,NY),NOTE8:PUT (NX+60,NY),NOTE16:PUT (NX+75,NY),NOTE32:PUT (NX+90,NY),NOTE64:TX=RX+15*FNL2!(TIME):PUT (TX,NY),NCURS
  193. 14090  LINE (0,RY-2)-(115,RY-2),3:PUT (RX,RY),REST1:PUT (RX+15,RY),REST2:PUT (RX+30,RY),REST4:PUT (RX+45,RY),REST8:PUT (RX+60,RY),REST16:PUT (RX+75,RY),REST32:PUT (RX+90,RY),REST64:PUT (STAFFX,STAFFY),STAFF
  194. 14120  FOR X=1 TO 5:LINE (STAFFX+46,STAFFY-X*5)-(STAFFX+60,STAFFY-X*5),1:LINE (STAFFX+46,STAFFY+X*5+45)-(STAFFX+60,STAFFY+X*5+45),1:NEXT X:LINE (STAFFX+46,STAFFY+MIDC)-(STAFFX+60,STAFFY+MIDC),1:PUT (NDX,NDY(NN)),NOTE4
  195. 14160  GOSUB 12000:LOCATE 12,22:DEF SEG:POKE 78,1:PRINT"PC Blues Box":LOCATE 14,21:DEF SEG:POKE 78,2:PRINT "A Music Editor":LOCATE 15,21:PRINT "For The IBM PC"
  196. 14165  X$="CDEFGAB":FOR X=0 TO 6:PLAY "MB O="+VARPTR$(X)+"T100 L32 X" +VARPTR$(X$)+"X"+VARPTR$(X$):NEXT :FOR X=18 TO 12 STEP -1:LOCATE X,16:PRINT STRING$(24,32):NEXT
  197. 14170  LOCATE 10,16:PRINT "F1 DOWN   Octave   UP F2"
  198. 14190  LOCATE 11,16:PRINT "F3 START  Block   END F4"
  199. 14200  LOCATE 12,16:PRINT "F5 INSRT  Block   DEL F6"
  200. 14210  LOCATE 13,16:PRINT "F7 PREV.  Block  NEXT F8"
  201. 14220  LOCATE 14,16:PRINT "F9 PREV.  Note   NEXT F0"
  202. 14230  LOCATE 15,16:PRINT "S  SAVE   File   LOAD  L"
  203. 14240  LOCATE 16,16:PRINT "C  CLEAR  Music  PLAY  P"
  204. 14250  LOCATE 17,16:PRINT "N  NOTE   Edit  TEMPO  T"
  205. 14260  LOCATE 18,16:PRINT "[Esc]   Stop Play  [Esc]"
  206. 14265  LOCATE 19,16:PRINT "Ctrl-C  Quit     Menu  M"
  207. 14270  RETURN
  208. 14990  '
  209. 14992  '         ***** SET UP Y COORDINATES FOR DRAWING        *****
  210. 14993  '         ***** NOTES AND THE X COORDINATES FOR DRAWING *****
  211. 14994  '         ***** PIANO KEYS.                             *****
  212. 15000  RESTORE:FOR X=1 TO 35:READ NDY(X):NDY(X)=NDY(X)+STAFFY:NEXT:FOR X=1 TO 5:READ BK(X):NEXT:RETURN
  213. 15010  DATA 57,55,52,50,47,45,42,40,37,35,32,30,27,25,17,10,7,5,2,0,-3,-5,-8,-10,-13,-15,-18,-20,-23,-25,-28,-30,-33,-35,-38,15,30,60,75,90
  214. 15990  '
  215. 15992  '         ***** ACCEPT A NOTE INTO THE BUFFER. *****
  216. 15998  '
  217. 16000  GOSUB 11000:M$="T000O0L00Na ":LZ=-((TEMPO<10)+(TEMPO<100)):MID$(M$,2+LZ)=FNS$(STR$(TEMPO)):MID$(M$,6)=FNS$(STR$(OC)):LZ=-(TIME<10):MID$(M$,8+LZ)=FNS$(STR$(TIME))
  218. 16060  IF NOT NOTE THEN MID$(M$,10)="P"+FNS$(STR$(TIME)) ELSE MID$(M$,10)=N$:IF DOTTED THEN MID$(M$,12)="."
  219. 16070  M$(NPOS)=M$:IF NOTE THEN PLAY M$
  220. 16090  NPOS=NPOS+1:IF NPOS>NCOUNT THEN NCOUNT=NCOUNT+1
  221. 16110  IF NPOS=NCOUNT THEN RETURN
  222. 16120  C7$=MID$(M$(NPOS),10,2):N7$=LEFT$(C7$,1):OC7=VAL(MID$(M$(NPOS),6,1)):DOTTED=(RIGHT$(M$(NPOS),1)="."):TIME=VAL(MID$(M$(NPOS),8,2)):NOTE=NOT (ASC(N7$)=80)
  223. 16160  SH7=(RIGHT$(C7$,1)="#"):FL7=(RIGHT$(C7$,1)="-"):IF NOTE THEN PTNPTR=(12*(OC7-1)+INSTR(PSCALE$,N7$)-SH7+FL7)*2-1:RETURN ELSE PTNPTR=49:RETURN
  224. 16167  '
  225. 16168  '         ***** UN-DEFINE THE FUNCTION KEYS *****
  226. 16169  '
  227. 16170  FOR X=1 TO 10:KEY X, "":NEXT X
  228. 16171  RETURN
  229. 16990  '
  230. 16992  '         ***** FILE OPERATIONS(LOAD AND SAVE). *****
  231. 16998  '
  232. 17000  ON ERROR GOTO 17500
  233. 17010  GOSUB 11000:LOCATE 22,16:LINE INPUT "File >";F$:LOCATE 22,16:PRINT STRING$(24,32):OPEN F$ FOR INPUT AS #1:INPUT #1,BCOUNT:INPUT #1,NCOUNT:IF BCOUNT<>0 THEN FOR X=1 TO BCOUNT:INPUT #1,BLOCK(X,1):INPUT #1,BLOCK(X,2):NEXT X
  234. 17060  BPOS=BCOUNT:FOR X=1 TO NCOUNT-1:INPUT #1,M$(X):NEXT X:CLOSE #1:NPOS=NCOUNT:TIME=4:DOTTED=FALSE:NOTE=TRUE:PTNPTR=49:TEMPO=VAL(MID$(M$(1),2,3))
  235. 17065  RETURN
  236. 17070  ON ERROR GOTO 0
  237. 17490  '
  238. 17492  '         ***** RETURN IF NO DATA FILE *****
  239. 17498  '
  240. 17500  IF ERR=53 THEN LOCATE 22,16:PRINT STRING$(24,32):LOCATE 22,16:PRINT "NO FILE CALLED ";F$:FOR X=1 TO 5000:NEXT X:LOCATE 22,16:PRINT STRING$(24,32):GOSUB 22030:RESUME 17065
  241. 17520  END
  242. 18000  GOSUB 11000:LOCATE 22,16:LINE INPUT "FILE >";F$:LOCATE 22,16:PRINT STRING$(24,32):OPEN F$ FOR OUTPUT AS #1:PRINT #1,BCOUNT:PRINT #1,NCOUNT:IF BCOUNT<>0 THEN FOR X=1 TO BCOUNT:PRINT #1,BLOCK(X,1):PRINT #1,BLOCK(X,2):NEXT X
  243. 18060  BPOS=BCOUNT:FOR X=1 TO NCOUNT-1:PRINT #1,M$(X):NEXT X:CLOSE #1:NPOS=NCOUNT:TIME=4:DOTTED=FALSE:NOTE=TRUE:PTNPTR=49:RETURN
  244. 18990  '
  245. 18992  '         ***** PLAY THE MUSIC *****
  246. 18998  '
  247. 19000  GOSUB 11000:PLAY "MB":FOR X=1 TO NCOUNT-1:IF INKEY$=CHR$(27) THEN RETURN ELSE PLAY M$(X)
  248. 19020  NEXT :RETURN
  249. 19990  '
  250. 19992  '         ***** SET TEMPO *****
  251. 19998  '
  252. 20000  GOSUB 11000:LOCATE 22,16:LINE INPUT "Tempo (32-255) >";X$:TEMPO=VAL(X$):IF TEMPO<32 OR TEMPO>255 THEN TEMPO=100
  253. 20010  LOCATE 22,16:PRINT STRING$(24,32):RETURN
  254. 20990  '
  255. 20992  '         ***** MOVE NOTE TO EDIT *****
  256. 20998  '
  257. 21000  GOSUB 11000:LOCATE 22,16:LINE INPUT "Edit Which Note # >";X$:LOCATE 22,16:PRINT STRING$(24,32):IF VAL(X$)<1 OR VAL(X$)>=NCOUNT THEN RETURN
  258. 21010  NPOS=VAL(X$):C7$=MID$(M$(NPOS),10,2):N7$=LEFT$(C7$,1):OC7=VAL(MID$(M$(NPOS),6,1)):DOTTED=(RIGHT$(M$(NPOS),1)="."):TIME=VAL(MID$(M$(NPOS),8,2)):NOTE=NOT (ASC(N7$)=80)
  259. 21020  TEMPO=VAL(MID$(M$(NPOS),2,3))
  260. 21060  SH7=(RIGHT$(C7$,1)="#"):FL7=(RIGHT$(C7$,1)="-"):IF NOTE THEN PTNPTR=(12*(OC7-1)+INSTR(PSCALE$,N7$)-SH7+FL7)*2-1:RETURN ELSE PTNPTR=49:RETURN
  261. 21990  '
  262. 21992  '         ***** CLEAR THE MUSIC BUFFER *****
  263. 21998  '
  264. 22000  GOSUB 11000:LOCATE 22,16:LINE INPUT "Are You Sure >";X$:LOCATE 22,16:PRINT STRING$(24,32)
  265. 22010  IF X$="" THEN RETURN
  266. 22020  IF FNU$(X$)<>"Y" THEN RETURN
  267. 22030  BCOUNT=0:NCOUNT=1:NPOS=1:TIME=4:NOTE=TRUE:DOTTED=FAFSE:PTNPTR=49:TIME=4:TEMPO=100:RETURN
  268. 22990  '
  269. 22992  '         ***** QUIT *****
  270. 22998  '
  271. 23000  GOTO 51000
  272. 49990  '
  273. 49992  '         ***** TEMPORARY LINE TO HANDLE UNIMPLEMENTED COMMANDS *****
  274. 49998  '
  275. 50000  GOSUB 11000:LOCATE 22,16:PRINT "Not yet implemented.":FOR X=1 TO 1000:NEXT X:LOCATE 22,16:PRINT STRING$(24,32):RETURN
  276. 51000  CLS:FU$(1)=CHR$(12)+"LIST "
  277. 51010  FU$(2)="RUN"+CHR$(13)
  278. 51020  FU$(3)="LOAD"+CHR$(34)
  279. 51030  FU$(4)="SAVE"+CHR$(34)
  280. 51040  FU$(5)="RUN"+CHR$(34)+"MENU"+CHR$(13)
  281. 51050  FU$(6)=","+CHR$(34)+"LPT1:"+CHR$(34)+CHR$(13)
  282. 51060  FU$(7)="TRON"+CHR$(13)
  283. 51070  FU$(8)="WIDTH 80"+CHR$(13)+"CLS"+CHR$(13)
  284. 51080  FU$(9)="COLOR 2,0,0"+CHR$(13)
  285. 51090  FU$(10)="SCREEN 0,0,0"+CHR$(13)
  286. 51110  FOR X=1 TO 10:KEY X,FU$(X):NEXT X
  287. 51120  SCREEN 0,0,0:CLS:COLOR 2,0,0:WIDTH 80
  288.